perm filename MPREP.OLD[MSS,LCS] blob sn#353874 filedate 1978-05-10 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		DIMENSION ICRS(5),IOCT(5)
C00010 ENDMK
C⊗;
	DIMENSION ICRS(5),IOCT(5)
	COMMON /INP/JN,I(80) /NAM/NAM  /J/J,JJ,JX /MKS/ MKS(11)
	1 /LST/J1,J2,J3,J4,J5,NTS(1000),IRH(700),IM(500)
	1 ,IB(500),ISL(500)
	EQUIVALENCE (LBRK,MKS(5)),(IRBRK,MKS(6))
	
	CALL STRTUP

400	J1=0
	J2=0
	J3=0
	J4=0
	J5=0
	JN=0
	N=0

	DO 300 K=1,500
	IM(K)=0
300	ISL(K)=0
 
100	IF(N.NE.';')GO TO 500
	CALL WRITER
C NOW START ANOTHER STAFF.
	GO TO 400
500	CALL READ(LND)
CC	IF(I(1).EQ.'I')GO TO 50
C 'I' IS FOR 'INSERT' FEATURE
	J=0
201	JX=0
200	J=J+1
	IF(J.GT.LND)GO TO 100
	N=I(J)
	IF(N.EQ.' ')GO TO 200
	JJ=J
C JJ= PTR TO START OF ITEM
	GO TO(1,2,3,7,8,9,10)LETNUM(N)
C FINDS LETTER, NUM., / OR ;, < OR >, [ OR ], ( , ) , *
 
1	JC=I(J+1)
 	IF(N.GT.'G')GO TO 20
C JUMP IF NOT SCALE LETTER
	IF(N.EQ.'B'.AND.JC.EQ.'A')GO TO 21
C JUMP IF BA (=BASS CLEF)
	IF(N.EQ.'A'.AND.JC.EQ.'L')GO TO 21
C JUMP IF AL (=ALTO CLEF)
C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
	IF(N.NE.'C')GO TO 22
	IF(JC.EQ.'+'.OR.JC.EQ.'-'.OR.JC.EQ.'X')GO TO 80
C JUMP FOR CRESC. (C+), DECRESC. (C-), OR END OF ONE OF THEM (CX)
C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
22	JX=1
122	N=ICHAR(J)
	IF(N.EQ.' ')GO TO 23
	IF(N.EQ.'/')GO TO 23
	IF(N.NE.';')GO TO 22
23	J=J-1
C NOW WE HAVE A NOTE
	CALL UPDATE(NTS,J1)
	GO TO 200

20	IF(N.NE.'R')GO TO 21
	JX=0
	IF(JC.EQ.'E')GO TO 301
C JUMP FOR 'REP' CODE 
	GO TO 122
21	IF(N.EQ.'P')GO TO 22
	IF(N.NE.'O')GO TO 121
C P=PROX., O=ORDIN.  BOTH ARE FOLLOWED BY NOTES.  O+ = OTTAVA
	IF(JC.EQ.'+')GO TO 85
	IF(JC.EQ.'X')GO TO 86
	GO TO 22
121	N=ICHAR(J)
	IF(N.NE.'/'.AND.N.NE.';')GO TO 121
C NOW WE'VE FOUND /TR/  /SU/  K2F/  ETC.
	CALL UPDATE(NTS,J1)
	GO TO 201
 
2 	N=ICHAR(J)
12	IF(NUMS(N))GO TO 2
25	J=J-1
CCC	IF(I(J).EQ.'0')I(J)='G'
28	CALL UPDATE(IRH,J2)
	GO TO 200
3	CALL ONEUP(NTS,J1,N)
	CALL ONEUP(IRH,J2,N)
C PUT IN THE / OR ;
	IF(JX.NE.0)JN=JN+1 
	GO TO 200

C SLURS
9	ISL(J5+1)=ISGN(J)
	J5=J5+2
	M=-1
	GO TO 24

10	N=J5
C SLUR END POINT
110	IF(ISL(N).EQ.0)GO TO 109
	N=N-2
C ADD AN ERROR TRAP HERE
	GO TO 110
109	ISL(N)=JN+1
	GO TO 200
  
C BEAMS
8	IF(I(J+2).EQ.IRBRK)GO TO 4
	J4=J4+1
	IB(J4)=ISGN(J)
	M=0
24	IF(NUMS(I(J+1)).EQ.0)GO TO 200
C JUMP OUT IF NO NUMB. FOLLOWS [ OR (
	N=ICHAR(J)
	CALL A2I(J,N)
C GO CHANGE ASCII TO INTEGER
	N=N+JN
	IF(M)GO TO 34
	CALL ONEUP(IB,J4,N)
	GO TO 200
34	ISL(J5)=N
C SLUR END POINT
	GO TO 200

4	J=J+2
	IF(NUMS(I(J+1)))GO TO 42
	JC=';'
	JD=0
	N=1
14	J4=J4+3
	IB(J4-2)=I(J-N)
	IB(J4-1)='B'
	IB(J4)=JC
	IF(JD.EQ.0)GO TO 200
	J4=J4+1
	IB(J4)=JD
	GO TO 200
42	JC=ICHAR(J)
	JD=';'
	N=2
	GO TO 14
 
7	N=JN+1
74	CALL I2A(N,MM,M,N)
	J3=J3+4
	IM(J3-3)=MM
	IM(J3-2)=M
	IM(J3-1)=N
	IM(J3)=' '
70	N=ICHAR(J)
	IF(N.EQ.' ')GO TO 70
	IF(NUMS(N))GO TO 73
C NOW SHOULD BE LETTERS
	L=J+1
C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
CC	DO 71 L=J+1,LND
77	N=I(L)
	IF(N.NE.'.')GO TO 71
	IM(J3)=N
	IM(J3+1)=I(L+1)
C ONLY ONE DIGIT TO RIGHT OF DECIMAL IS ALLOWED.
	IM(J3+2)=' '
	J3=J3+3
	I(L)=' '
	L=L-1
	I(L)=' '
71	IF(N.EQ.'>'.OR.N.EQ.' ')GO TO 75
78	L=L+1
	IF(L.LE.LND)GO TO 77
75	DO 72 N=J,L-1
	J3=J3+1
72	IM(J3)=I(N)
	J=L
	J3=J3+1
	IM(J3)='/'
	GO TO 76
79	J=J+1
76	IF(I(J).EQ.'>')GO TO 200
	IF(I(J).EQ.' ')GO TO 79
CC	IF(ICHAR(J).EQ.' ')GO TO 76
C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
	J=J-1
	GO TO 7

73	CALL A2I(J,N)
C CHANGES ASCII TO INTEGER
	N=N+JN
	GO TO 74
C*********↓↓↓↓↓↓↓↓↓↓↓↓*********************
80	IF(JC.EQ.'X')GO TO 81
C SETSUP 1ST PART OF CRESC-DECRESC
	CALL CROCT(ICRS,N,JC)
84	J=J+2
	IF(NUMS(I(J)))J=J+1
	IF(NUMS(I(J)))J=J+1
	J=J-1
	GO TO 200
85	CALL CROCT(IOCT,N,JC)
	GO TO 84
81	CALL CROCX(ICRS)
	GO TO 84
86	CALL CROCX(IOCT)
	GO TO 84
	
C*********↑↑↑↑↑↑↑↑↑↑↑↑*********************
 
301	J=J+2
CODE FOR 'REP N M/'
	JC=-1
30	N=ICHAR(J)
	IF(N.EQ.' ')GO TO 30
	CALL A2I(J,N)
	IF(JC.GE.0)GO TO 31
	JC=N
C JC IS NOW 1ST NUM AFTER REP.
	GO TO 30
31	JD=J1
C N IS NOW 2ND NUMBER.
	IRP=0
	ITM=0
	JZ=JC
33	MM=JD
32	JD=JD-1
	IF(NTS(JD).NE.'/')GO TO 32
C BACK UP TO PREV. SLASH
	IF(MM-JD.GT.1)GO TO 35
	IRP=IRP+1
	GO TO 33
C NOW LOOK FORWARD TO 1ST CHAR. AFTER SLASH
35	MM=NTS(JD+1)
	IF(MM.EQ.'R')GO TO 36
	IF(MM.EQ.'O')GO TO 37
	IF(MM.EQ.'P')GO TO 37
	IF(MM.GT.'G')GO TO 33
37	ITM=ITM+1
36	JZ=JZ-1
38	IF(JZ.GT.0)GO TO 33
	JN=JN+ITM*(N-1)
	CALL UPDATE(NTS,J1)
	GO TO 28
 
	END
	
	SUBROUTINE CROCT(K,N,JC)
	DIMENSION K(1)
	COMMON /INP/JN,I(1) /J/J
C SETSUP 1ST PART OF CRESC-DECRESC, OTTAVA
	K(1)=JN+1
	K(2)=N
 	K(3)=JC
	K(4)=I(J+2)
	K(5)=I(J+3)
C K5 SHOULD BE / ; BLANK OR NUM.
	END

	SUBROUTINE CROCX(K)
	COMMON /INP/JN,I(1) /J/J
	COMMON /LST/J1,J2,J3,J4,J5,NTS(1000),IRH(700),IM(500)
	DIMENSION K(1)
81	CALL I2A(K(1),MM,M,N)
 	J3=J3+4
  	IM(J3-3)=M  
 	IM(J3-2)=N
 	IF(K(4).NE.'.')GO TO 82
	IM(J3-1)=K(4)
	IM(J3)=K(5)
	J3=J3+2
82	IM(J3-1)=' '
	IM(J3)=K(2)
	IM(J3+1)=K(3)
 	IM(J3+2)=' '
	N=JN+1
	CALL I2A(N,MM,M,N)
	J3=J3+6
	IM(J3-3)=M
	IM(J3-1)=N
	IF(I(J+2).NE.'.')GO TO 83
	IM(J3)=I(J+2)
	IM(J3+1)=I(J+3)
	J3=J3+2
83	IM(J3)='/'
	END